home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MySounds.p < prev    next >
Encoding:
Text File  |  1996-05-29  |  2.8 KB  |  136 lines  |  [TEXT/CWIE]
  1. unit MySounds;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     procedure InitSounds;
  9. { Call at start of app }
  10.     procedure IdleSounds;
  11. { Call regularly to release channels after sounds have finished }
  12. { Usually called from the event loop }
  13.     procedure FinishSounds;
  14. { Call at termination of app }
  15.     procedure PlaySounds (theSound: Handle);
  16. { Play a sound from a Handle }
  17.     procedure PlaySoundsID (id: integer);
  18. { Play a sounds from a "snd " resource }
  19.  
  20. implementation
  21.  
  22.     uses
  23.         Sound,Memory,Resources;
  24.  
  25.     const
  26.         max_sounds = 10; { Excessive? }
  27.  
  28.     type
  29.         soundRecordState = (SR_Unused, SR_Inuse, SR_Finished);
  30.         mySoundRecord = record
  31.                 state: soundRecordState;
  32.                 sound_chan: SndChannelPtr;
  33.             end;
  34.  
  35.     var
  36.         sounds: array[1..max_sounds] of mySoundRecord;
  37.  
  38.     procedure InitSounds;
  39.         var
  40.             i: integer;
  41.     begin
  42.         for i := 1 to max_sounds do begin
  43.             sounds[i].state := SR_Unused;
  44.             sounds[i].sound_chan := SndChannelPtr(Newptr(SizeOf(SndChannel)));
  45.         end;
  46.     end;
  47.  
  48.     procedure IdleSounds;
  49.         var
  50.             oe: OSErr;
  51.             i: integer;
  52.     begin
  53.         for i := 1 to max_sounds do begin
  54.             if sounds[i].state = SR_Finished then begin
  55.                 oe := SndDisposeChannel(sounds[i].sound_chan, false);
  56.                 sounds[i].state := SR_Unused;
  57.             end;
  58.         end;
  59.     end;
  60.  
  61.     procedure FinishSounds;
  62.         var
  63.             i: integer;
  64.             finished: boolean;
  65.     begin
  66.         finished := false;
  67.         while not finished do begin
  68.             IdleSounds;
  69.             finished := true;
  70.             for i := 1 to max_sounds do begin
  71.                 if sounds[i].state <> SR_Unused then
  72.                     finished := false;
  73.             end;
  74.         end;
  75.     end;
  76.  
  77. {$PUSH}
  78. {$D-}
  79. { Called at interupt level! }
  80.     procedure ChanCallBack (chan: SndChannelPtr; cmd: SndCommand);
  81.         var
  82.             p: ^soundRecordState;
  83.     begin
  84.         p := POINTER(cmd.param2);
  85.         p^ := SR_Finished;
  86.     end;
  87. {$POP}
  88.  
  89.     procedure PlaySounds (theSound: Handle);
  90.         var
  91.             oe: OSErr;
  92.             myWish: SndCommand;
  93.             i: integer;
  94.     begin
  95.         if (theSound <> nil) & (theSound^ <> nil) then begin
  96.             IdleSounds;
  97.             i := 1;
  98.             while (i <= max_sounds) & (sounds[i].state <> SR_Unused) do begin
  99.                 i := i + 1;
  100.             end;
  101.             if i <= max_sounds then begin
  102.                 sounds[i].sound_chan^.qLength := stdQLength;
  103.                 oe := SndNewChannel(sounds[i].sound_chan, 0, 0, @ChanCallBack);
  104.                 if oe = noErr then begin
  105.                     MoveHHi(theSound);
  106.                     HLock(theSound);
  107.                     oe := SndPlay(sounds[i].sound_chan, SndListHandle(theSound), true);
  108.  
  109.                     if oe = noErr then begin
  110.                         with myWish do begin { set up a sound mgr command block }
  111.                             cmd := callBackCmd;  { set playing to false }
  112.                             param1 := 0;
  113.                             param2 := ord(@sounds[i].state);
  114.                         end; {with}
  115.                         oe := SndDoCommand(sounds[i].sound_chan, myWish, false);
  116.                     end;
  117.                     if oe = noErr then begin
  118.                         sounds[i].state := SR_Inuse;
  119.                     end
  120.                     else begin
  121.                         oe := SndDisposeChannel(sounds[i].sound_chan, false);
  122.                     end;
  123.                 end;
  124.             end;
  125.         end;
  126.     end;
  127.  
  128.     procedure PlaySoundsID (id: integer);
  129.         var
  130.             theSound: Handle;
  131.     begin
  132.         theSound := GetResource('snd ', id);
  133.         PlaySounds(theSound);
  134.     end;
  135.  
  136. end.